home *** CD-ROM | disk | FTP | other *** search
- /*
- * @(#)builtins.c 1.10 3/13/89
- */
- #include "assert.h"
- #include "tokens.h"
- #include "MyParser.h"
- #include "nodes.h"
- #include "builtins.h"
- #include "buildATs.h"
- #include "evaluate.h"
- #include "semantics.h"
- #include "sequence.h"
- #include "symbols.h"
- #include "version.h"
- #include "environment.h"
- #include "opNames.h"
- extern char *currentFileName;
-
- extern NodePtr buildString();
- char *builtinNames[] = {
- "_abstracttypeobject",
- "_anyobject",
- "_arrayobject",
- "_booleanobject",
- "_characterobject",
- "_conditionobject",
- "_integerobject",
- "_nilobject",
- "_nodeobject",
- "_signatureobject",
- "_realobject",
- "_stringobject",
- "_vectorobject",
- "_timeobject",
- "_nodelistelementobject",
- "_nodelistobject",
- "_instreamobject",
- "_outstreamobject",
- "_immutablevectorobject",
- "_bitchunkobject",
- "_riscobject",
- "_handlerobject",
- "_vectorofcharobject",
- "_bufferobject"
- };
-
- char *builtinTypeNames[] = {
- "abstracttype",
- "any",
- "array",
- "boolean",
- "character",
- "condition",
- "integer",
- "nil",
- "node",
- "signature",
- "real",
- "string",
- "vector",
- "time",
- "nodelistelement",
- "nodelist",
- "instream",
- "outstream",
- "immutablevector",
- "bitchunk",
- "risc",
- "handler",
- "vectorofchar",
- "buffer"
- };
-
- extern Node
- abstracttypeobject,
- anyobject,
- arrayobject,
- booleanobject,
- characterobject,
- conditionobject,
- integerobject,
- nilobject,
- nodeobject,
- signatureobject,
- realobject,
- stringobject,
- vectorobject,
- timeobject,
- nodelistelementobject,
- nodelistobject,
- instreamobject,
- outstreamobject,
- immutablevectorobject,
- bitchunkobject,
- riscobject,
- handlerobject,
- vectorofcharobject,
- bufferobject;
-
- static NodePtr builtins[] = {
- &abstracttypeobject,
- &anyobject,
- &arrayobject,
- &booleanobject,
- &characterobject,
- &conditionobject,
- &integerobject,
- &nilobject,
- &nodeobject,
- &signatureobject,
- &realobject,
- &stringobject,
- &vectorobject,
- &timeobject,
- &nodelistelementobject,
- &nodelistobject,
- &instreamobject,
- &outstreamobject,
- &immutablevectorobject,
- &bitchunkobject,
- &riscobject,
- &handlerobject,
- &vectorofcharobject,
- &bufferobject
- };
-
- Boolean conformTable[] = {
- /* abstracttypeobject */ FALSE,
- /* anythingobject */ FALSE,
- /* arrayobject */ FALSE,
- /* booleanobject */ TRUE,
- /* characterobject */ TRUE,
- /* conditionobject */ TRUE,
- /* integerobject */ TRUE,
- /* nilobject */ FALSE,
- /* nodeobject */ TRUE,
- /* signatureobject */ TRUE,
- /* realobject */ TRUE,
- /* stringobject */ TRUE,
- /* vectorobject */ TRUE,
- /* timeobject */ TRUE,
- /* nodelistelementobject */ FALSE,
- /* nodelistobject */ FALSE,
- /* instreamobject */ FALSE,
- /* outstreamobject */ FALSE,
- /* immutablevectorobject */ TRUE,
- /* bitchunkobject */ TRUE,
- /* riscobject */ FALSE,
- /* handlerobject */ FALSE,
- /* vectorofcharobject */ TRUE,
- /* bufferobject */ FALSE
- };
-
- NodePtr instATOfBuiltins[NUMBUILTINS];
- NodePtr instCTOfBuiltins[NUMBUILTINS];
- NodePtr ATOfBuiltins[NUMBUILTINS];
-
- NodePtr refToBuiltinFromToken(tag, token)
- B_Tag tag;
- Token token;
- {
- register int index;
- switch (token) {
- case KABSTRACTTYPE:
- index = ABSTRACTTYPEINDEX;
- break;
- case KANY:
- index = ANYINDEX;
- break;
- case KARRAY:
- index = ARRAYINDEX;
- break;
- case KBOOLEAN:
- index = BOOLEANINDEX;
- break;
- case KCHARACTER:
- index = CHARACTERINDEX;
- break;
- case KCONDITION:
- index = CONDITIONINDEX;
- break;
- case KINTEGER:
- index = INTEGERINDEX;
- break;
- case KNODE:
- index = NODEINDEX;
- break;
- case KNONE:
- index = NILINDEX;
- break;
- case KNIL:
- index = NILINDEX;
- break;
- case KREAL:
- index = REALINDEX;
- break;
- case KSIGNATURE:
- index = SIGNATUREINDEX;
- break;
- case KSTRING:
- index = STRINGINDEX;
- break;
- case KVECTOR:
- index = VECTORINDEX;
- break;
- case KTIME:
- index = TIMEINDEX;
- break;
- default:
- index = (int) token;
- assert(index >= 0 && index < NUMBUILTINS);
- }
- return(refToBuiltin(tag, index));
- }
-
- int loadedDummyBuiltins;
-
- static NodePtr createDummyAT(id)
- OID id;
- {
- char namestring[32];
- NodePtr result, name;
- name = Construct(P_SYMDEF, 0);
- result = Construct(P_ATLIT, 4, buildString(currentFileName), NULL, name, NULL);
- sprintf(namestring, "dummy_0x%08x", id);
- name->b.symdef.ident = Ident_Lookup(namestring, strlen(namestring));
- name->b.symdef.symbol = ST_Create(NN, name->b.symdef.ident);
- name->b.symdef.symbol->isManifest = TRUE;
- name->b.symdef.symbol->hasValue = TRUE;
- name->b.symdef.symbol->value.value = result;
- name->b.symdef.symbol->value.ATinfo = refToBuiltin(B_INSTAT, SIGNATUREINDEX);
- name->b.symdef.symbol->value.value = refToBuiltin(B_INSTCT, SIGNATUREINDEX);
-
- defineGlobal(result, id);
- setStage(id, E_Imported);
- return(result);
- }
-
- static NodePtr createDummyCT(id)
- OID id;
- {
- NodePtr result;
- result = Construct(P_OBLIT, 10, buildString(currentFileName), NULL, NULL,
- NULL, NULL, NULL, NULL, NULL, NULL, NULL);
- defineGlobal(result, id);
- setStage(id, E_Imported);
- return(result);
- }
-
- static void loadDummyBuiltins()
- {
- register int i;
- register NodePtr b;
- loadedDummyBuiltins = 1;
- for (i = 0; i < NUMBUILTINS; i++) {
- b = builtins[i];
- b->tag = P_OBLIT;
- defineGlobal(b, (OID)BUILTINOBJECTBASE + i);
- setStage((OID)BUILTINOBJECTBASE+i, E_Imported);
- b->b.oblit.instat = createDummyAT(OIDOfBuiltin(B_INSTAT, i));
- instATOfBuiltins[i] = b->b.oblit.instat;
- ATOfBuiltins[i] = createDummyAT(OIDOfBuiltin(B_ITSAT, i));
- if (conformTable[i]) {
- if (i != VECTORINDEX && i != IMMUTABLEVECTORINDEX)
- instCTOfBuiltins[i] = createDummyCT(OIDOfBuiltin(B_INSTCT, i));
- }
- }
- }
-
- NodePtr figureOutInstCode(s, index)
- NodePtr s;
- int index;
- {
- register NodePtr r, result;
- NodePtr createName;
-
- createName = Construct(P_OPNAME, 0);
- createName->b.opname.id = ON_Translate("create");
- /*
- * Knowing the AT gives us the CT, so we need to load the
- * instCTofBuiltins table with the thing we get by invoking create on
- * this guy.
- */
- r = findObjectOperation(s, createName);
- if (r == NULL) {
- assert(index == NILINDEX || index == NODEINDEX ||
- index == SIGNATUREINDEX || index == ABSTRACTTYPEINDEX ||
- index == ANYINDEX || index == RISCINDEX ||
- index == HANDLERINDEX);
- result = Construct(P_OBLIT, 10, buildString(currentFileName), NULL, NULL,
- NULL, NULL, NULL, NULL, NULL, NULL, NULL);
- setCodeOID(result, INSTCTOFBUILTINOBJECTBASE + index);
- } else {
- assert(r->tag == P_OPDEF);
- r = r->b.opdef.body;
- assert(r->tag == P_BLOCK);
- r = r->b.block.stats;
- assert(r->tag == T_SEQUENCE);
- assert(r->nChildren == 1);
- r = r->b.children[0];
- if (r->tag == P_ASSIGNSTAT) {
- assert(r->b.assignstat.left->tag == T_SEQUENCE);
- assert(r->b.assignstat.left->nChildren == 1);
- assert(r->b.assignstat.right->tag == T_SEQUENCE);
- assert(r->b.assignstat.right->nChildren == 1);
- result = GETVALUE(r->b.assignstat.right->b.children[0]);
- assert(result->tag == P_OBLIT);
- setCodeOID(result, INSTCTOFBUILTINOBJECTBASE + index);
- } else if (r->tag == P_PRIMSTAT) {
- assert(index == CONDITIONINDEX);
- result = Construct(P_OBLIT, 10, buildString(currentFileName), NULL, NULL,
- NULL, NULL, NULL, NULL, NULL, NULL, NULL);
- setCodeOID(result, INSTCTOFBUILTINOBJECTBASE + index);
- } else assert(FALSE);
- }
- return(result);
- }
-
- NodePtr findInstCode(s)
- NodePtr s;
- {
- register NodePtr r, result;
- NodePtr createName;
-
- createName = Construct(P_OPNAME, 0);
- createName->b.opname.id = ON_Translate("create");
- /*
- * Knowing the AT gives us the CT, so we need to know the codeOID
- * of the thing we get by invoking create on this guy.
- */
- r = findObjectOperation(s, createName);
- if (r == NULL) return(NULL);
- if (r->tag != P_OPDEF) return(NULL);
- r = r->b.opdef.body;
- if (r->tag != P_BLOCK) return(NULL);
- r = r->b.block.stats;
- if (r->tag != T_SEQUENCE) return(NULL);
- if (r->nChildren != 1) return(NULL);
- r = r->b.children[0];
- if (r->tag != P_ASSIGNSTAT) return(NULL);
- if (r->b.assignstat.left->tag != T_SEQUENCE) return(NULL);
- if (r->b.assignstat.left->nChildren != 1) return(NULL);
- if (r->b.assignstat.right->tag != T_SEQUENCE) return(NULL);
- if (r->b.assignstat.right->nChildren != 1) return(NULL);
- result = r->b.assignstat.right->b.children[0];
- if (result->tag != P_OBLIT) return(NULL);
- return(result);
- }
-
- NodePtr figureOutOfResult(s)
- NodePtr s;
- {
- register NodePtr r, result;
- NodePtr ofName;
-
- ofName = Construct(P_OPNAME, 0);
- ofName->b.opname.id = ON_Translate("of");
- /*
- * This is a three level guy, and we want the two level one.
- */
- r = findObjectOperation(s, ofName);
- assert(r != NULL);
- assert(r->tag == P_OPDEF);
- r = r->b.opdef.body;
- assert(r->tag == P_BLOCK);
- r = r->b.block.stats;
- assert(r->tag == T_SEQUENCE);
- assert(r->nChildren == 1);
- r = r->b.children[0];
- assert(r->tag == P_ASSIGNSTAT);
- assert(r->b.assignstat.left->tag == T_SEQUENCE);
- assert(r->b.assignstat.left->nChildren == 1);
- assert(r->b.assignstat.right->tag == T_SEQUENCE);
- assert(r->b.assignstat.right->nChildren == 1);
- result = r->b.assignstat.right->b.children[0];
- assert(result->tag == P_OBLIT);
- /*
- * This used to say
- * setCodeOID(result, OIDOfBuiltin(B_INSTAT, index));
- *
- * it should really just make sure that the code oid is made known in the
- * object table.
- */
- if (getCodeOID(result) != 0) OTInsert(result, getCodeOID(result));
- return(result);
- }
-
- extern void scanForGlobals();
-
- void loadBuiltins()
- {
- register int i;
- register NodePtr b;
- NodePtr p, s;
- int *loadBlockPtr, thisBlockSize;
-
- if (builtins[0]->tag == T_NONE) {
- loadDummyBuiltins();
- return;
- }
- loadedDummyBuiltins = 0;
- loadBlockPtr = (int *)&abstracttypeobject;
- loadBlockPtr = loadBlockPtr - 3;
- while (*loadBlockPtr == TREEMAGIC) {
- assert(*(loadBlockPtr + 1) == TREEVERSION);
- thisBlockSize = *(loadBlockPtr + 2);
- #ifdef sun
- /* On SunOS4, these are rounded to 8 bytes */
- #define roundup(A, B) (((A)+(B)-1) & ~((B) - 1))
- thisBlockSize = roundup(thisBlockSize, 8);
- #endif
- p = (NodePtr) (loadBlockPtr + 3);
- assert(p->tag == P_ATLIT || p->tag == P_OBLIT);
- scanForGlobals(p, FALSE);
- loadBlockPtr += (thisBlockSize / 4);
- }
- for (i = 0; i < NUMBUILTINS; i++) {
- b = builtins[i];
- assert(b->b.oblit.id == OIDOfBuiltin(B_IT, i));
- if ((s = b->b.oblit.instat) == NULL) {
- /*
- * This should be a vector or array.
- */
- assert(i == VECTORINDEX || i == ARRAYINDEX || i == IMMUTABLEVECTORINDEX);
- b = figureOutOfResult(b);
- assert(b->tag == P_OBLIT);
- } else {
- assert(b->b.oblit.codeOID == OIDOfBuiltin(B_ITSCT, i));
- s = GETVALUE(s);
- assert(s->tag == P_ATLIT);
- assert(s->b.atlit.id == OIDOfBuiltin(B_INSTAT, i));
- assert(s->b.atlit.f.cannotBeConformedTo == conformTable[i]);
- instATOfBuiltins[i] = s;
- instCTOfBuiltins[i] = figureOutInstCode(b, i);
- if (instCTOfBuiltins[i] != NULL)
- OTInsert(instCTOfBuiltins[i], getCodeOID(instCTOfBuiltins[i]));
- if (conformTable[i]) {
- assert(getCodeOID(instCTOfBuiltins[i]) == getCodeOID(s));
- }
- }
- }
- }
-
- prepareBuiltinForOutput(s, objectName)
- NodePtr s;
- char *objectName;
- {
- register NodePtr instat, myat, news;
- NodePtr instCode, lp;
- OID theNewOID;
- int i;
-
- /* fix the OID of the object */
- assert(s->tag == P_OBLIT);
- for (i=0; i<NUMBUILTINS && strcmp(objectName,builtinNames[i]); i++);
- assert(i < NUMBUILTINS);
- if (i == VECTOROFCHARINDEX || i == NODELISTINDEX) {
- Symbol st;
- st = s->b.oblit.name->b.symref.symbol;
- st->itsName = objectName;
- }
- theNewOID = BUILTINOBJECTBASE + i;
- Map_Insert(translateOIDMap, (int)s->b.oblit.id, (int)theNewOID);
- defineGlobal(s, theNewOID);
- OTInsert(s, OIDOfBuiltin(B_ITSCT, i));
-
- Map_Delete(environmentMap, (int)OIDOfBuiltin(B_IT, i));
- Map_Delete(environmentMap, (int)OIDOfBuiltin(B_ITSAT, i));
- Map_Delete(environmentMap, (int)OIDOfBuiltin(B_ITSCT, i));
- Map_Delete(environmentMap, (int)OIDOfBuiltin(B_INSTAT, i));
- Map_Delete(environmentMap, (int)OIDOfBuiltin(B_INSTCT, i));
-
- /* and the at of its instances */
- instat = s->b.oblit.instat;
- if (instat == NULL) {
- assert(i == VECTORINDEX || i == ARRAYINDEX || i == IMMUTABLEVECTORINDEX);
- news = figureOutOfResult(s);
- assert(news->tag == P_OBLIT);
-
- /* find the result of getSignature, and set it to conformTable[i] */
- if (conformTable[i]) {
- assert(i == VECTORINDEX || i == IMMUTABLEVECTORINDEX);
- lp = Construct(P_OPNAME, 0);
- lp->b.opname.id = ON_Translate("getsignature");
- lp = findObjectOperation(news, lp);
- assert(lp->tag == P_OPDEF);
- lp = lp->b.opdef.body->b.block.stats->b.children[0];
- assert(lp->tag == P_ASSIGNSTAT);
- lp = lp->b.assignstat.right->b.children[0];
- assert(lp->tag == P_SYMREF);
- lp = lp->b.symref.symbol->value.value;
- assert(lp->tag == P_ATLIT);
- lp->b.atlit.f.cannotBeConformedTo = TRUE;
- lp->b.atlit.f.isVector = TRUE;
- }
-
- /* set the code oid of the builtin object itself */
- setCodeOID(news, OIDOfBuiltin(B_ITSCT, i));
-
- /* set the inst code oid */
- instCode = figureOutInstCode(news, i);
- assert(instCode->tag == P_OBLIT);
- if (! instCode->b.oblit.f.doesNotDuplicateSelf ||
- ! instCode->b.oblit.f.doesNotMoveArguments ||
- ! instCode->b.oblit.f.doesNotMoveSelf) {
- printf("Builtin (%d) with funny flags\n", i);
- instCode->b.oblit.f.doesNotDuplicateSelf = TRUE;
- instCode->b.oblit.f.doesNotMoveArguments = TRUE;
- instCode->b.oblit.f.doesNotMoveSelf = TRUE;
- instCode->b.oblit.f.resultsDependOnlyOnArgs = TRUE;
- }
- if (i == VECTORINDEX || i == IMMUTABLEVECTORINDEX) {
- instCode->b.oblit.f.isVector = TRUE;
- } else {
- instCode->b.oblit.f.isVector = FALSE;
- }
- setCodeOID(instCode, OIDOfBuiltin(B_INSTCT, i));
- OTInsert(instCode, OIDOfBuiltin(B_INSTCT, i));
- } else {
- assert(i != VECTORINDEX && i != ARRAYINDEX && i != IMMUTABLEVECTORINDEX);
- news = s;
- theNewOID = OIDOfBuiltin(B_INSTAT, i);
- if (instat->tag == P_GLOBALREF) {
- resolveGlobal(instat, (ValuePtr)NULL);
- instat->b.globalref.id = theNewOID;
- instat = instat->b.globalref.value;
- assert(instat != NULL);
- }
- assert(instat->tag == P_ATLIT);
- instat->b.atlit.f.cannotBeConformedTo = conformTable[i];
-
- /* set the code oid of the builtin object itself */
- setCodeOID(news, OIDOfBuiltin(B_ITSCT, i));
-
- /* set the inst code oid, and inst code in the at if necessary */
- instCode = figureOutInstCode(news, i);
- assert(instCode->tag == P_OBLIT);
- if (conformTable[i]) setCodeOID(instat, OIDOfBuiltin(B_INSTCT, i));
- assert(instCode != NULL);
- if (i == NODELISTINDEX || i == BITCHUNKINDEX || i == VECTOROFCHARINDEX) {
- instCode->b.oblit.f.isVector = TRUE;
- } else {
- instCode->b.oblit.f.isVector = FALSE;
- }
- setCodeOID(instCode, OIDOfBuiltin(B_INSTCT, i));
- OTInsert(instCode, OIDOfBuiltin(B_INSTCT, i));
-
- if (instCode->b.oblit.name != NULL) {
- assert(instCode->b.oblit.name->tag == P_SYMDEF);
- assert(instCode->b.oblit.name->b.symdef.symbol != NULL);
- assert(instCode->b.oblit.name->b.symdef.symbol->value.ATinfo->tag == P_ATLIT);
- Map_Insert(translateOIDMap,
- (int)instCode->b.oblit.name->b.symdef.symbol->value.ATinfo->b.atlit.id,
- (int)theNewOID);
- instCode->b.oblit.name->b.symdef.symbol->value.ATinfo = instat;
- }
- if (instCode->b.oblit.myat != NULL) {
- assert(instCode->b.oblit.myat->tag == P_ATLIT);
- Map_Insert(translateOIDMap,
- (int)instCode->b.oblit.myat->b.atlit.id,
- (int)theNewOID);
- instCode->b.oblit.myat = instat;
- }
- Map_Insert(translateOIDMap, (int)instat->b.atlit.id, (int)theNewOID);
- assert(instat->b.atlit.f.writeSeparately);
- defineGlobal(instat, theNewOID);
- }
-
- /* and the at of the object */
- myat = s->b.oblit.myat;
- assert(myat != NULL);
- theNewOID = ATOFBUILTINOBJECTBASE + i;
- if (myat->tag == P_GLOBALREF) {
- resolveGlobal(myat, (ValuePtr)NULL);
- myat->b.globalref.id = theNewOID;
- myat = myat->b.globalref.value;
- assert(myat != NULL);
- }
- assert(myat->tag == P_ATLIT);
- Map_Insert(translateOIDMap, (int)myat->b.atlit.id, (int)theNewOID);
- defineGlobal(myat, theNewOID);
- }
-
-
- NodePtr refToBuiltin(tag, index)
- B_Tag tag;
- int index;
- {
- register NodePtr r;
- switch (tag) {
- case B_IT:
- r = builtins[index];
- break;
- case B_ITSAT:
- r = ATOfBuiltins[index];
- break;
- case B_ITSCT:
- r = builtins[index];
- break;
- case B_INSTAT:
- r = instATOfBuiltins[index];
- break;
- case B_INSTCT:
- r = instCTOfBuiltins[index];
- if (r == NULL || r->b.oblit.name == NULL) {
- r = Construct(P_GLOBALREF, 0);
- r->b.globalref.id = OIDOfBuiltin(tag, index);
- }
- break;
- default:
- assert(FALSE);
- break;
- }
- return(r);
- }
-